COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY RENAM
C00004 ENDMK
C⊗;
ENTRY RENAM

	A←1 ↔ B←2 ↔ C←3 ↔ P←17 ↔ SVN ← 4 ↔ CHN ← 11

	;RENAME FOR FORTRAN
	; CALL(OLDNAME,OLDEXT,NEWNAME,NEWEXT)
	; HALTS ON ERROR OR FILE NOT FOUND
	

RENAM:	0
	HRRZI REGS
	BLT REGS+4
	EXCH P,SVP

GONE:	MOVE SVN,@(16)		;FIRST FILE NAME
	MOVE B,[POINT 6,NAME]
	PUSHJ P,SEVN26

	MOVE SVN,@1(16)		;FIRST EXT
	MOVE B,[POINT 6,NAME+1]
	PUSHJ P,SEVN26
	
	SETZM NAME+3		;NO PPN

	OPEN CHN,[14↔'DSK   '↔0]
	JRST ERROR
	LOOKUP CHN,NAME
	JRST ERROR

	MOVE SVN,@2(16)		;SECOND FILE NAME
	MOVE B,[POINT 6,NAME]
	PUSHJ P,SEVN26

	MOVE SVN,@3(16)		;SECOND EXT
	MOVE B,[POINT 6,NAME+1]
	PUSHJ P,SEVN26
	
	SETZM NAME+3		;NO PPN??
	RENAME CHN,NAME
	JRST CKDEL		;CHECK FOR OLD FILE

	HRLZI REGS
	BLT 4
	EXCH P,SVP
	JRA 16,4(16)


SEVN26:	MOVE A,[POINT 7,SVN]	;SEVEN TO SIXBIT
	SETZM (B)
	MOVEI C,5
SIXOOP:	ILDB A
	CAIN " "
	POPJ P,
	SUBI 40
	IDPB B
	SOJG C,SIXOOP
	POPJ P,	

CKDEL:	HRRZ NAME+1
	CAIE 4		;SEE IF FILE EXISTS
	JRST ERROR

	OPEN 12,[14↔'DSK   '↔0]
	JRST ERROR
	SETZM NAME+3
	LOOKUP 12,NAME
	JRST ERROR

	SETZM NAME
	RENAME 12,NAME	;DELETE IT
	JRST 4,.
	JRST GONE
	
ERROR:			;GETS HERE IF ERROR OR FILE NOT FOUND

	JRST 4,.	;HALT

NAME:	BLOCK 4
REGS:	BLOCK 5
SVP:	-10,,PDL
PDL:	BLOCK 10

END